home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / EDUCMATH / CURVEFIT.LZH / BASLISTI.BAS < prev    next >
BASIC Source File  |  1987-10-22  |  11KB  |  190 lines
  1. 1 REM This program allows a "PRETTY" listing of BASIC programs that
  2. 2 REM are stored in ASCII format.  Although designed to be used primarily
  3. 3 REM with EPSON or EPSON code compatible printers, this program can be
  4. 4 REM used with any printer, so long as the set-up is made prior to running
  5. 5 REM this program.
  6. 6 REM 
  7. 7 REM This program has the option of placing one statement per printed line.
  8. 8 REM It also has the option of stripping the high bit from a file that might
  9. 9 REM have been generated using the document mode of WORDSTAR
  10. 10 REM 
  11. 11 REM This program is PUBLIC DOMAIN.  Feel free to copy or distribute
  12. 12 REM freely.  The author is:  Thomas S. Cox.
  13. 13 REM
  14. 14 REM The listings may be printed to printer, disk, or screen.
  15. 15 REM
  16. 16 REM For optimum results, this program should be compiled.  Will work
  17. 17 REM using either QUICK-BASIC or TURBO-BASIC.
  18. 18 REM
  19. 19 REM ======================================================================
  20. 20 'CLEAR 5000    'Required only for OBASIC not MBASIC or BASICA
  21. 30 CLOSE:CLS    'Clear Screen Code for IBM, May be machine dependent
  22. 40 EM$="N"   
  23. 100 ' For ZORBA use Print CHR$(27)+"E"; For IBM, use CLS
  24. 110 PRINT TAB(15);"---------------------------------------------"
  25. 111 PRINT TAB(15);"|  BASLISTI.BAS  Copyright April 13, 1987   |"
  26. 112 PRINT TAB(15);"|     For IBM and COMPATIBLE Computers      |"
  27. 114 PRINT TAB(15);"|  BASIC PROGRAM LISTER  Version 2.06       |"
  28. 116 PRINT TAB(15);"|  (ASCII FORMAT)        April 13, 1987     |"
  29. 118 PRINT TAB(15);"|                                           |"
  30. 120 PRINT TAB(15);"|  PROGRAM BY:     Thomas S. Cox            |"
  31. 122 PRINT TAB(15);"|                  102 Evergreen Street     |"
  32. 124 PRINT TAB(15);"|                  Easley, SC  29640        |"
  33. 126 PRINT TAB(15);"|                                           |"
  34. 128 PRINT TAB(15);"|  PUBLIC DOMAIN SOFTWARE.  May be freely   |"
  35. 130 PRINT TAB(15);"|  copied.  Please leave this sign-on       |"
  36. 132 PRINT TAB(15);"|  message on all copies.  Thanks.          |"
  37. 133 PRINT TAB(15);"|                                           |"
  38. 134 PRINT TAB(15);"|  This version allows setting printer CPI  |"
  39. 135 PRINT TAB(15);"|  [If printer is Epson or Compatible]      |"
  40. 136 PRINT TAB(15);"|                                           |"
  41. 137 PRINT TAB(15);"|  Printer left margin can also be set.     |"
  42. 138 PRINT TAB(15);"---------------------------------------------"
  43. 139 PRINT" " 
  44. 140 DUMMY$="123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789|123456789"
  45. 160 OP=0:LINE INPUT"Output listing to printer (Y)es or (N)o   {DEFAULT=Y} ";OP$:IF OP$="" THEN OP$="Y"
  46. 170 IF LEFT$(OP$,1)="Y" OR LEFT$(OP$,1)="y" THEN OP=1 ELSE IF LEFT$(OP$,1)="N" OR LEFT$(OP$,1)="n" THEN OP=0 ELSE PRINT"Your input of ";OP$;" was invalid.  Please re-enter":GOTO 160
  47. 180 LINE INPUT"Use current system Time and Date? Y or N (Default = Y) ";Z1$:IF LEFT$(Z1$,1)="y" OR LEFT$(Z1$,1)="Y" OR Z1$="" THEN TD$=DATE$+"   "+TIME$:GOTO 182
  48. 181 LINE INPUT"Please enter desired Time and Date for Heading (25 chars Max) ";TD$
  49. 182 LINE INPUT "Should printed output use OTHER than Current Settings Y or N (Default=N) ";CP$
  50. 183 IF LEFT$(CP$,1)="Y" OR LEFT$(CP$,1)="y" THEN GOSUB 6000
  51. 184 PRINT "SHOULD OUTPUT HAVE HIGH-BITS STRIPPED?  THIS WILL REMOVE ALL THE"
  52. 185 PRINT "STRANGE WORDSTAR DOCUMENT CHARACTERS; BUT WILL ALSO REMOVE THE IBM"
  53. 186 LINE INPUT "GRAPHICS CHARACTERS.  Please enter (Y)es or (N)o ";SHB$
  54. 187 if left$(shb$,1)="Y" or left$(shb$,1)="y" then shb=1 else shb=0
  55. 190 LINE INPUT"Maximum number of characters per line (Default is 80) ";MC$:MC=VAL(MC$)
  56. 191 IF MC=0 THEN MC=80
  57. 192 'WIDTH LPRINT MC      'USED ONLY FOR CP/M VERSIONS OF OBASIC AND MBASIC
  58. 194 ' FOR IBM BASICA THE PROPER FORMAT IS  'WIDTH "LPT1:",MC'
  59. 196 LINE INPUT "Please enter number of lines per page (Default is 55) ";LL$:LL=VAL(LL$)
  60. 198 IF LL=0 THEN LL=55
  61. 200 LINE INPUT "Multistatement lines one statement per line (Y)es or (N)o  {DEFAULT=Y} ";MS$:IF MS$="" THEN MS$="Y"
  62. 210 IF LEFT$(MS$,1)="Y" OR LEFT$(MS$,1)="y" THEN ML=1 ELSE IF LEFT$(MS$,1)="N" OR LEFT$(MS$,1)="n" THEN ML=0 ELSE PRINT"Your input of ";ML$;" was invalid.  Please re-enter.":GOTO 200 
  63. 220 LINE INPUT "Please enter the filename of program to be printed  ";F$
  64. 230 OL=0
  65. 240 LINE INPUT "Output listing to Disk File (Y)es or (N)o   {DEFAULT=N} ";OL$:IF OL$="" THEN OL$="N"
  66. 250 IF LEFT$(OL$,1)="Y" OR LEFT$(OL$,1)="y" THEN OL=1 ELSE IF LEFT$(OL$,1)="N" OR LEFT$(OL$,1)="n" OR OL$="" THEN 290 ELSE PRINT"Your entry of ";OL$;"was ivalid.  Please re-enter."
  67. 260 OL=1:LINE INPUT"Please enter filename for disk storage of listing  ";FS$
  68. 290 LP=0:N=1
  69. 296 LINE INPUT "Left Margin Offset for Line Printer? {DEFAULT=1 CAN'T BE 0} ";LM$:LM=VAL(LM$):IF LM<1 THEN LM=1
  70. 297 GOSUB 8000
  71. 298 IF OL=1 THEN OPEN "O",2,FS$
  72. 299 N=1:IF OP=1 THEN LPRINT " "
  73. 300 OPEN "I",1,F$
  74. 301 LINE INPUT #1,B$
  75. 302 IF ASC(B$)=255 THEN CLS:PRINT CHR$(7):PRINT"SORRY, THE FILE YOU SPECIFIED IS NOT IN ASCII FORMAT (IT IS TOKENIZED)":PRINT " ":CLOSE 1:GOTO 110
  76. 304 CLOSE 1
  77. 305 OPEN "I",1,F$:IF EOF(1) THEN GOTO 297
  78. 307 B1$=" );=":A2$=" "
  79. 310 CLS:GOSUB 1000     'print title at start of first page
  80. 320 IF EOF(1) THEN GOTO 380  'if no more data then quit
  81. 330 LINE INPUT #1,B$ 'read file up through next CR/LF
  82. 360 GOSUB 2000   'Start extraction of MC Column lines
  83. 370 GOTO 320
  84. 380 CLS:PRINT"END of File"    'When all has been done, eject page and STOP
  85. 385 GOSUB 5000
  86. 390 IF OP=1 THEN LPRINT CHR$(12)    'CHR$(12)=Form Feed
  87. 400 IF OL=1 THEN PRINT #2,CHR$(12)
  88. 405 REM Close all open files
  89. 410 CLOSE
  90. 415 PRINT CHR$(7):GOTO 297
  91. 420 END
  92. 1000 ' This subroutine prints Titles, Page Numbers, etc.
  93. 1003 PRINT TD$;TAB(42);F$;"  Page # ";N:PRINT STRING$(79,61)
  94. 1004 PRINT LEFT$(DUMMY$,79):PRINT STRING$(79,61)
  95. 1005 IF OL=1 THEN PRINT #2,TAB(LM);TD$,TAB(42+LM);F$;"  Page # ";N
  96. 1010 IF OP=1 THEN LPRINT TAB(LM);TD$;TAB(42+LM);F$;"   Page ";N
  97. 1015 GOSUB 5000
  98. 1030 LP=2:RETURN  
  99. 2000 ' This subroutine extracts up to MC characters for a line
  100. 2010 K1=1:F=0:Q1=1:CC=LM
  101. 2020 FOR I=1 TO LEN(B$)
  102. 2023 IF MQ=1 THEN GOSUB 3000
  103. 2030 CC=CC+1:A1$=MID$(B$,I,1):IF CC=MC THEN GOSUB 3000
  104. 2046 IF CC>=(MC-8) AND INSTR(1,B1$,A1$) THEN MQ=1
  105. 2050 IF ML=0 THEN 2100
  106. 2060 IF A1$=CHR$(34) THEN Q1=Q1*-1
  107. 2070 IF Q1<0 THEN 2100
  108. 2090 IF A1$=":" THEN GOSUB 3000
  109. 2095 IF A1$>CHR$(127) and SHB=1 THEN GOSUB 4000    'Strip any high bits
  110. 2100 NEXT I
  111. 2110 GOSUB 3000
  112. 2120 RETURN
  113. 3000 ' This subroutine PRINTS a string up to MC characters in length
  114. 3005 F1$=MID$(B$,K1,I-K1)
  115. 3010 IF F1$="" THEN RETURN
  116. 3020 IF F=1 THEN K=(INSTR(1,B$,A2$)+1)+LM:IF OP=1 THEN LPRINT TAB(K-1);
  117. 3030 IF F=1 AND OL=1 THEN PRINT #2,TAB(K-1);
  118. 3035 IF F<>1 THEN K=LM:IF OP=1 THEN LPRINT TAB(K);
  119. 3037 IF F<>1 AND OL=1 THEN PRINT #2,TAB(K);
  120. 3040 IF OP=1 THEN LPRINT F1$
  121. 3050 IF OL=1 THEN PRINT #2,F1$
  122. 3055 IF F=1 THEN PRINT TAB(K-LM);
  123. 3056 PRINT F1$
  124. 3060 K1=I:LP=LP+1:MQ=0
  125. 3062 IF F<>1 THEN CC=LM+(INSTR(1,B$,A2$)+1)
  126. 3064 IF F=1 THEN CC=K
  127. 3066 F=1
  128. 3070 IF LP>=LL THEN LP=0:N=N+1:IF OP=1 OR OL=1  THEN GOSUB 5000:IF OP=1 THEN LPRINT CHR$(12)
  129. 3080 IF OL=1 AND LP=0 THEN PRINT #2,CHR$(12)
  130. 3090 IF LP=0 THEN GOSUB 1000
  131. 3100 RETURN
  132. 4000 N2=ASC(A1$):N2=N2-128:MID$(B$,I,1)=CHR$(N2):RETURN
  133. 5000 IF OP=1 THEN LPRINT TAB(LM);STRING$(MC-LM,61)
  134. 5005 IF OL=1 THEN PRINT #2,TAB(LM);STRING$(MC-LM,61)
  135. 5010 IF OP=1 THEN LPRINT TAB(LM);LEFT$(DUMMY$,MC-LM):LPRINT TAB(LM);STRING$(MC-LM,61)
  136. 5015 IF OL=1 THEN PRINT #2,TAB(LM); LEFT$(DUMMY$,MC-LM):PRINT #2,TAB(LM);STRING$(MC-LM,61)
  137. 5020 RETURN
  138. 6000 CLS:PRINT"This routine allows changing characters per inch in printed output."
  139. 6002 PRINT" ":PRINT"You may abort this routine without sending any characters to line printer"
  140. 6004 PRINT"by pressing ENTER rather than (1-4).":PRINT" "
  141. 6010 PRINT "Your choices are:":PRINT" "
  142. 6020 PRINT "(1) Default  10 Characters per inch"
  143. 6030 PRINT "(2) Elite  12 Characters per inch"
  144. 6040 PRINT "(3) Compressed  17 characters per inch"
  145. 6050 PRINT "(4) Maximum compression  20 characters per inch"
  146. 6055 PRINT "    (This known to work on CITIZEN MSP 20 and 25 printers)"
  147. 6060 PRINT " "
  148. 6100 LINE INPUT "Please enter your choice (1-4) or <ENTER> to abort. ";N1$:N1=VAL(N1$)
  149. 6105 IF N1=0 THEN CLS:RETURN
  150. 6110 IF N1=1 THEN LPRINT CHR$(27)+"@";:GOSUB 7000: CLS:RETURN
  151. 6120 IF N1>4 THEN CLS: GOTO 6000
  152. 6130 IF N1=2 THEN LPRINT CHR$(27)+"@";CHR$(27)+"M";:GOSUB 7000:CLS:RETURN
  153. 6140 IF N1=3 THEN LPRINT CHR$(27)+"@";CHR$(15);:GOSUB 7000:CLS:RETURN
  154. 6150 IF N1=4 THEN LPRINT CHR$(27)+"@";CHR$(27)+"M";CHR$(15);:GOSUB 7000:CLS:RETURN
  155. 6160 GOTO 6000
  156. 7000 LINE INPUT"Would you like printer in EMPHASIZED mode (Y)es or (N)o ";EM$
  157. 7010 IF LEFT$(EM$,1)="Y" OR LEFT$(EM$,1)="y" THEN LPRINT CHR$(27);CHR$(69);:RETURN
  158. 7020 RETURN
  159. 8000 CLS
  160. 8010 PRINT STRING$(78,"=")
  161. 8020 PRINT "|";TAB(78);"|"
  162. 8030 PRINT "|";TAB(15);"SETUP FOR PRINTOUT IS AS FOLLOWS: ";TAB(78);"|"
  163. 8040 PRINT "|";TAB(78);"|"
  164. 8050 PRINT "|";TAB(15);"FILE TO BE LISTED ";TAB(50);F$;TAB(78);"|"
  165. 8060 PRINT "|";TAB(15);"Output to printer?";TAB(50);OP$;TAB(78);"|"
  166. 8070 PRINT "|";TAB(15);"Title for listing ";TAB(50);TD$;TAB(78);"|"
  167. 8080 PRINT "|";TAB(15);"Max # Chars/Line  ";TAB(50);MC;TAB(78);"|"
  168. 8090 PRINT "|";TAB(15);"Lines per page    ";TAB(50);LL;TAB(78);"|"
  169. 8150 PRINT "|";TAB(15);"Multi-Statement Lines = 1/line? ";TAB(50);MS$;TAB(78);"|"
  170. 8160 PRINT "|";TAB(15);"Output listing to disk?";TAB(50);OL$;TAB(78);"|"
  171. 8170 PRINT "|";TAB(15);"Filename for disk OUTPUT ";TAB(50);FS$;TAB(78);"|"
  172. 8180 PRINT "|";TAB(15);"Printer Left Margin Offset";TAB(50);LM;TAB(78);"|"
  173. 8190 PRINT "|";TAB(15);"Printer in EMPHASIZED mode? ";TAB(50);EM$;TAB(78);"|"
  174. 8195 IF N1=0 THEN PRINT"|";TAB(15);"Printer set at CPI? ";TAB(50);"As Currently Set";TAB(78);"|"
  175. 8200 IF N1=1 THEN PRINT"|";TAB(15);"Printer set at CPI? ";TAB(50);"10";TAB(78);"|"
  176. 8210 IF N1=2 THEN PRINT"|";TAB(15);"Printer set at CPI? ";TAB(50);"12";TAB(78);"|"
  177. 8220 IF N1=3 THEN PRINT"|";TAB(15);"Printer set at CPI? ";TAB(50);"17";TAB(78);"|"
  178. 8230 IF N1=4 THEN PRINT"|";TAB(15);"Printer set at CPI? ";TAB(50);"20";TAB(78);"|"
  179. 8240 PRINT STRING$(78,"="):PRINT" "             
  180. 8250 LINE INPUT "OK to use above settings ENTER or Y for YES, N for NO ";OK$
  181. 8260 IF OK$="" OR LEFT$(OK$,1)="Y" OR LEFT$(OK$,1)="y" THEN RETURN
  182. 8270 PRINT"The only change permissable without re-running program is "
  183. 8280 PRINT"FILENAME of program to be listed.":PRINT" "
  184. 8290 LINE INPUT"ENTER new FILENAME or <ENTER> to ABORT or 'R' to RESET everything ";TMP$
  185. 8300 IF TMP$="" THEN GOTO 8000
  186. 8310 IF LEFT$(TMP$,1)="R" OR LEFT$(TMP$,1)="r" THEN TMP$="R":GOTO 20
  187. 8400 F$=TMP$
  188. 8410 GOTO 8000
  189. 9000 END
  190.